SuperHack/SuperHack CD.bin/CODING/GRAPHICS/TWEAKFLC.ZIP/TWKUNIT.PAS

Pascal/Delphi Source File | 1995-12-23 | 15.8 KB | 993 lines

UNIT TwkUnit;

Interface

Uses Graph;

Const Red=  1;
      Green=2;
      Blue= 3;

Type VirScreen=   Array[0..199,0..319] Of Byte;
     VirScreenPtr=^VirScreen;
     FileStr=     String[66];
     TwkPalette=  Array[0..255,Red..Blue] Of Byte;
Var screen21,screen22: VirScreenPtr;
    s21seg,s22seg:     Word;
    s21ofs,s22ofs:     Word;
    twkcolor:          Byte;

PROCEDURE InitTweak;
PROCEDURE DoneTweak;
PROCEDURE TwkCopyVir(sourceseg,startpos: Word);
PROCEDURE TwkCopyPage2;
PROCEDURE TwkClearPage2;
PROCEDURE TwkLoadPCXPage2(fn: String; Var pal: TwkPalette);
PROCEDURE TwkGetPCXPalette(fn:      String;
                           Var pal: TwkPalette);
PROCEDURE TwkSetPalette(pal: TwkPalette; be,en: Word);
PROCEDURE TwkHLinePage2(x,y,x1: Word);
PROCEDURE TwkVLinePage2(x,y,y1: Word);
PROCEDURE TwkPutImagePage2(x,y:         Word;
                           imseg,imofs: Word);
PROCEDURE TwkTransPutImagePage2(x,y:         Word;
                                imseg,imofs: Word);
PROCEDURE TwkGetImagePage2(x,y,x1,y1:   Word;
                           imseg,imofs: Word);
PROCEDURE TwkBarPage2(x,y,x1,y1: Word);
PROCEDURE TwkPutPixel(x,y: Word; color: Byte);
PROCEDURE TwkPut16x16(x,y:         Word;
                      imseg,imofs: Word);
PROCEDURE TwkTransPut16x16(x,y:         Word;
                           imseg,imofs: Word);
FUNCTION TwkGetPixel(x,y: Word): Byte;
PROCEDURE TwkGet16x16(x,y:         Word;
                      imseg,imofs: Word);

Implementation

PROCEDURE TWEAK; external;
{$L TWK256.OBJ}

PROCEDURE InitTweak;
Var AutoDetectPointer : pointer;
    GraphDriver : integer;
    GraphMode   : integer;
    ErrorCode   : integer;

 {$F+}
 FUNCTION DetectVGA256: Integer;
 VAR DetectedDriver: Integer;
 BEGIN
  RegisterBGIdriver(@TWEAK);
  DetectVGA256:=0;
 END;
 {$F-}

 FUNCTION Initialize: Boolean;
 VAR InGraphicsMode : boolean;
     UseWhichDriver : Integer;
 BEGIN
  UseWhichDriver:=0;
  AutoDetectPointer:=@DetectVGA256;
  GraphDriver:=InstallUserDriver('Twk256',AutoDetectPointer);
  GraphDriver:=Detect;
  InitGraph(GraphDriver, GraphMode, '');
  ErrorCode:=GraphResult;
  if ErrorCode <> grOK Then
   Initialize:=False
  Else Initialize:=True;
 END;

BEGIN
 Initialize;
 GetMem(screen21,SizeOf(VirScreen));
 s21seg:=Seg(screen21^);
 s21ofs:=Ofs(screen21^); If s21ofs<>0 Then Halt;
 GetMem(screen22,SizeOf(VirScreen));
 s22seg:=Seg(screen22^);
 s22ofs:=Ofs(screen22^); If s22ofs<>0 Then Halt;
END;

PROCEDURE DoneTweak;
BEGIN
 FreeMem(screen21,SizeOf(VirScreen));
 FreeMem(screen22,SizeOf(VirScreen));
END;

{------------------------- Virtual screen routines --------------------------}

PROCEDURE TwkClearPage2; Assembler;
Asm
 {Set destination:}
 Mov es,s21seg
 Mov di,0
 {Set number of words to clear:}
 Mov cx,32000
 {Clear:}
 Cld
 Mov ax,0
 Rep Stosw
 {Set destination:}
 Mov es,s22seg
 Mov di,0
 {Set number of words to Clear:}
 Mov cx,32000
 {Clear:}
 Rep Stosw
END;

PROCEDURE TwkCopyVir(sourceseg,startpos: Word); Assembler;  {Startpos 16000 = y 100}
Label     Again0,Again1,Again2,Again3;
ASM
  PUSH  DS

  MOV   AX,SourceSeg
  MOV   DS,AX                   {DS = SourceSeg}
  MOV   AX,$A000
  MOV   ES,AX                   {ES = VideoBuffer}
  MOV   DX,$3C4                 {Sequencer Address}

  CLD
  MOV   AX,$0102
  OUT   DX,AX
  MOV   DI,startpos
  MOV   SI,0
  MOV   CX,25
  MOV   BX,80
Again0:
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  DEC   CX
  JNZ   Again0

  MOV   AX,$0202
  OUT   DX,AX
  SUB   DI,200
  SUB   SI,799
  MOV   CX,25
Again1:
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  DEC   CX
  JNZ   Again1

  MOV   AX,$0402
  OUT   DX,AX
  SUB   DI,200
  SUB   SI,799
  MOV   CX,25
Again2:
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  DEC   CX
  JNZ   Again2

  MOV   AX,$0802
  OUT   DX,AX
  SUB   DI,200
  SUB   SI,799
  MOV   CX,25
Again3:
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  MOVSB
  ADD   SI,3
  DEC   CX
  JNZ   Again3

  MOV   AX,$0102
  OUT   DX,AX
  MOV   CX,25

  SUB   SI,3

  DEC   BX
  JNZ   Again0

  POP   DS
END;

PROCEDURE TwkCopyPage2;
BEGIN
 TwkCopyVir(s21seg,0);
 TwkCopyVir(s22seg,16000);
END;

PROCEDURE TwkHLinePage2(x,y,x1: Word); Assembler;
ASM
 {Find screen half to use:}
 Cmp y,199
 Jg  @page2
 Mov es,s21seg
 Jmp @Draw
 @Page2:
 Mov es,s22seg
 Sub y,200
 @Draw:
 {Find first point:}
 Mov ax,y
 Mov cx,320
 Mul cx
 Add ax,x
 Mov di,ax
 {Find length:}
 Mov cx,x1
 Sub cx,x
 {Draw cx+1 points of twkcolor:}
 Mov al,twkcolor
 Mov ah,twkcolor
 Shr cx,1
 Jnc @DrawWords
 Stosb
 @DrawWords:
 Rep Stosw
 Stosb
END;

PROCEDURE TwkVLinePage2(x,y,y1: Word); Assembler;
ASM
 {Find initial screen half:}
 Cmp y,199
 Jg  @Page2
 Mov es,s21seg
 Jmp @Draw
 @Page2:
 Mov es,s22seg
 Sub y,200
 Sub y1,200
 @Draw:
 {Find first point:}
 Mov ax,y
 Mov cx,320
 Mul cx
 Add ax,x
 Mov di,ax
 {Find length:}
 Mov cx,y1
 Sub cx,y
 Inc cx
 Mov al,twkcolor
 {Draw cx points of twkcolor:}
 @NextByte:
 Mov es:[di],al
 Add di,320
 Cmp di,64000
 Jae @ChangePage
 Dec cx
 Jnz @NextByte
 Jmp @Over
 @ChangePage:
 Sub di,64000
 Mov es,s22seg
 Dec cx
 Jnz @NextByte
 @Over:
END;

PROCEDURE TwkSetPalette(pal: TwkPalette; be,en: Word);
Var s,o: Word;
BEGIN
 s:=Seg(pal); o:=Ofs(pal);
 ASM
  Mov ah,10h
  Mov al,12h
  Mov es,s
  Mov dx,o
  Mov bx,be
  Mov cx,en
  Int 10h
 END;
END;

PROCEDURE TwkLoadPCXPage2(fn: String; Var pal: TwkPalette);
Type Buffer= Array[1..8192] Of Byte;
     BufPtr= ^Buffer;
Var buf:     BufPtr;
    posi:    LongInt;
    f:       File;
    bread:   Word;
    count:   Word;
    scrseg:  Word;
    size:    LongInt;
    t:       Word;
    clv:     Byte;
    {c:       Word;}
    bseg:    Word;
    {al,cl:   Byte}
BEGIN
 GetMem(buf,SizeOf(Buffer));
 bseg:=Seg(buf^);
 Assign(f,fn);
 Reset(f,1);
 posi:=0; count:=0; scrseg:=s21seg;
 size:=FileSize(f)-769-128; clv:=0;
 Seek(f,128);
 While posi<size Do
 BEGIN
  If size-posi<SizeOf(Buffer) Then bread:=size-posi
  Else bread:=SizeOf(Buffer);
  BlockRead(f,buf^,bread);
  {For t:=1 To bread Do
  BEGIN
   al:=buf^[t];
   If cl>0 Then
   BEGIN
    For c:=x To x+cl-1 Do
     scr^[y,c]:=al;
    x:=c+1; cl:=0;
   END Else
    If al-192<0 Then
     BEGIN scr^[y,x]:=al; Inc(x); END Else cl:=al-192;
   If x=320 Then
   BEGIN
    x:=0; Inc(y);
    If y=200 Then
    BEGIN
     y:=0; scr:=screen22;
    END;
   END;
  END;}
  ASM
   {Set starting point:}
   Push ds
   Mov ax,count
   Mov di,ax
   Mov es,scrseg
   {Restore register from last run:}
   Mov cl,clv
   Mov ch,0
   Mov bx,s22seg
   {Counter in dx:}
   Mov dx,bread
   {Set input string:}
   Mov ds,bseg
   Mov si,0

   @ReadByte:
   Lodsb        {Read data}

   Cmp cl,0     {Last byte was a count?}
   Je  @OneData {No}
   {Write al cl times, and set cl to 0:}
   Rep Stosb
   Jmp @Next
   @OneData:
   Cmp al,192   {Is this a count?}
   Jae @Count   {Yes}
   {Write single data:}
   Stosb
   Jmp @Next
   @Count:
   Mov cl,al
   Sub cl,192

   @Next:
   Cmp di,64000 {Reached end of virtual screen 1}
   Jae @ChangeScr {Yes}
   Dec dx
   Jnz @ReadByte {Take next byte in buffer:}
   Jmp @Over

   {Change virtual screen:}
   @ChangeScr:
   Mov es,bx
   Mov di,0
   Dec dx
   Jnz @ReadByte

   {Restore ds and save registers}
   @Over:
   Pop ds
   Mov clv,cl
   Mov scrseg,es
   Mov count,di
  END;
  posi:=posi+bread;
 END;
 BlockRead(f,pal,1);
 BlockRead(f,pal,768);
 For t:=0 To 255 Do
 BEGIN
  pal[t,Red]:=pal[t,Red] shr 2;
  pal[t,Green]:=pal[t,Green] shr 2;
  pal[t,Blue]:=pal[t,Blue] shr 2;
 END;
 Close(f);
END;

PROCEDURE TwkGetPCXPalette(fn:      String;
                           Var pal: TwkPalette);
Var f: File;
    t: Byte;
BEGIN
 Assign(f,fn); Reset(f,1);
 Seek(f,FileSize(f)-768);
 BlockRead(f,pal,768);
 Close(f);
 For t:=0 To 255 Do
 BEGIN
  pal[t,1]:=pal[t,1] shr 2;
  pal[t,2]:=pal[t,2] shr 2;
  pal[t,3]:=pal[t,3] shr 2;
 END;
END;

PROCEDURE TwkPutImagePage2(x,y:         Word;
                           imseg,imofs: Word); Assembler;
ASM
 Cld
 {Find initial screen half:}
 Cmp y,199
 Jg  @Page2
 Mov es,s21seg
 Jmp @Draw
 @Page2:
 Mov es,s22seg
 Sub y,200
 @Draw:
 {Find first point:}
 Mov ax,y
 Mov cx,320
 Mul cx
 Add ax,x
 Mov di,ax
 {Examine bitmap:}
 Push ds
 Mov si,imofs
 Mov ds,imseg
 Lodsw         {Find width of image}
 Mov bx,ax
 Lodsw         {Find height of image}
 Mov dx,ax
 Add si,2      {Skip reserved word}
 {Copy line:}
 @NextLine:
 Mov cx,bx
 Rep Movsb
 {Go to start of next line:}
 Mov ax,320
 Sub ax,bx
 Add di,ax
 {Check if page boundary crossed:}
 Cmp di,64000
 Jb @NextByte
 {Change page:}
 Sub di,64000
 Mov cx,ds
 Pop ds
 Mov es,s22seg
 Push ds
 Mov ds,cx
 @NextByte:
 Dec dx
 Jnz @NextLine
 Pop ds
END;

PROCEDURE TwkGetImagePage2(x,y,x1,y1:   Word;
                           imseg,imofs: Word); Assembler;
ASM
 Cld
 {Find initial screen half:}
 Cmp y,199
 Jg  @Page2
 Mov es,s21seg
 Jmp @Copy
 @Page2:
 Mov es,s22seg
 Sub y,200
 Sub y1,200
 @Copy:
 {Find first point:}
 Mov ax,y
 Mov cx,320
 Mul cx
 Add ax,x
 Mov di,ax
 {Find bitmap width and height:}
 Mov bx,x1
 Sub bx,x
 Inc bx
 Mov dx,y1
 Sub dx,y
 Inc dx
 Push ds
 Mov si,di
 Mov di,imofs
 Mov ds,imseg
 Mov cx,ds
 Mov ax,es
 Mov es,cx
 Mov ds,ax
 Mov ax,bx
 Stosw
 Mov ax,dx
 Stosw
 Mov ax,0
 Stosw     {Store dummy reserved word for compatibility}
 {Copy line:}
 @NextLine:
 Mov cx,bx
 Rep Movsb
 {Go to start of next line:}
 Mov ax,320
 Sub ax,bx
 Add si,ax
 {Check if page boundary crossed:}
 Cmp si,64000
 Jb  @NextByte
 {Change page:}
 Sub si,64000
 Pop ds
 Mov ax,ds
 Mov ds,s22seg
 Push ax
 @NextByte:
 Dec dx
 Jnz @NextLine
 Pop ds
END;

PROCEDURE TwkTransPutImagePage2(x,y:         Word;
                                imseg,imofs: Word); Assembler;
ASM
 Cld
 {Find initial screen half:}
 Cmp y,199
 Jg  @Page2
 Mov es,s21seg
 Jmp @Draw
 @Page2:
 Mov es,s22seg
 Sub y,200
 @Draw:
 {Find first point:}
 Mov ax,y
 Mov cx,320
 Mul cx
 Add ax,x
 Mov di,ax
 {Examine bitmap:}
 Push ds
 Mov ds,imseg
 Mov si,imofs
 Lodsw         {Find width of image}
 Mov bx,ax
 Lodsw         {Find height of image}
 Mov dx,ax
 Add si,2      {Skip reserved word}
 {Transput line:}
 @NextLine:
 Mov cx,bx
 @DrawPixels:
 Lodsb
 Cmp al,0
 Jz  @NextPixel
 Stosb
 Dec cx
 Jnz @DrawPixels
 Jmp @SetupLine
 @NextPixel:
 Inc di
 Dec cx
 Jnz @DrawPixels
 {Go to start of next line:}
 @SetupLine:
 Mov ax,320
 Sub ax,bx
 Add di,ax
 {Check if page boundary crossed:}
 Cmp di,64000
 Jb @NextByte
 {Change page:}
 Sub di,64000
 Mov cx,ds
 Pop ds
 Mov es,s22seg
 Push ds
 Mov ds,cx
 @NextByte:
 Dec dx
 Jnz @NextLine
 Pop ds
END;

PROCEDURE TwkBarPage2(x,y,x1,y1: Word); Assembler;
ASM
 Cld
 {Find bitmap width and height:}
 Mov bx,x1
 Sub bx,x
 Inc bx
 Mov dx,y1
 Sub dx,y
 Inc dx
 Push dx
 {Find initial screen half:}
 Cmp y,199
 Jg  @Page2
 Mov es,s21seg
 Jmp @Copy
 @Page2:
 Mov es,s22seg
 Sub y,200
 @Copy:
 {Find first point:}
 Mov ax,y
 Mov cx,320
 Mul cx
 Add ax,x
 Mov di,ax
 {Draw bar:}
 Pop dx
 Mov al,twkcolor
 Mov ah,twkcolor
 @RepDraw:
 Mov cx,bx
 Shr cx,1
 Jnc @WordDraw
 Stosb
 @WordDraw:
 Rep Stosw
 Add di,320
 Sub di,bx
 Cmp di,64000
 Jb @NextLine
 {Change page:}
 Sub di,64000
 Mov es,s22seg
 @NextLine:
 Dec dx
 Jnz @RepDraw
END;

{---------------------- Direct screen access routines -----------------------}

PROCEDURE TwkPutPixel(x,y: Word; color: Byte); Assembler;
ASM
 {VGA address in es:}
 Mov ax,$A000
 Mov es,ax

 {Find position in video mem:}
 Mov ax,y
 Mov cx,80
 Mul cx
 Mov di,ax
 Mov bx,x
 Mov cl,bl
 Shr bx,2
 Add di,bx

 {Find plane:}
 And cx,11b
 Mov ah,1
 Shl ah,cl
 Mov al,02h

 Mov dx,$3C4
 Out dx,ax
 Mov al,color
 Mov es:[di],al
END;

PROCEDURE TwkPut16x16(x,y:         Word;
                      imseg,imofs: Word); Assembler;
ASM
 Push ds
 Push bp

 {VGA address in es:}
 Mov ax,$A000
 Mov es,ax

 {Find position in video mem:}
 Mov ax,y
 Mov cx,80
 Mul cx
 Mov di,ax
 Mov bx,x
 Mov cl,bl
 Shr bx,2
 Add di,bx

 {Find plane:}
 And cx,11b
 Mov ah,1
 Shl ah,cl
 Mov al,02h

 Mov si,imofs
 Mov ds,imseg
 Mov bp,ax

 {Set initial plane:}
 Mov dx,$3C4
 Out dx,ax

 Cld
 Mov bx,6
 @DrawHoriz:
 Mov cx,8
 @DrawVertical:
 Lodsb
 Mov es:[di],al
 Add di,80
 Dec cx
 Jnz @DrawVertical

 @NextPlane:
 Cmp bp,0102h
 Je  @SetPlane2
 Cmp bp,0202h
 Je  @SetPlane3
 Cmp bp,0402h
 Je  @SetPlane4
 Mov ax,0102h
 Jmp @SetThePlane
 @SetPlane2:
 Mov ax,0202h
 Jmp @SetThePlane
 @SetPlane3:
 Mov ax,0402h
 Jmp @SetThePlane
 @SetPlane4:
 Mov ax,0802h
 @SetThePlane:
 Mov bp,ax
 Out dx,ax
 Sub di,80*8
 Cmp bp,0102h
 Jne @NoAdd
 Add di,1
 @NoAdd:
 Dec bx
 Jnz @DrawHoriz

 @TheEnd:
 Pop bp
 Pop ds
END;

PROCEDURE TwkTransPut16x16(x,y:         Word;
                           imseg,imofs: Word); Assembler;
ASM
 Push ds
 Push bp

 {VGA address in es:}
 Mov ax,$A000
 Mov es,ax

 {Find position in video mem:}
 Mov ax,y
 Mov cx,80
 Mul cx
 Mov di,ax
 Mov bx,x
 Mov cl,bl
 Shr bx,2
 Add di,bx

 {Find plane:}
 And cx,11b
 Mov ah,1
 Shl ah,cl
 Mov al,02h

 Mov si,imofs
 Mov ds,imseg
 Mov bp,ax

 {Set initial plane:}
 Mov dx,$3C4
 Out dx,ax

 Cld
 Mov bx,6
 @DrawHoriz:
 Mov cx,8
 @DrawVertical:
 Lodsb
 Cmp al,0
 Jz  @NextByte
 Mov es:[di],al
 @NextByte:
 Add di,80
 Dec cx
 Jnz @DrawVertical

 @NextPlane:
 Cmp bp,0102h
 Je  @SetPlane2
 Cmp bp,0202h
 Je  @SetPlane3
 Cmp bp,0402h
 Je  @SetPlane4
 Mov ax,0102h
 Jmp @SetThePlane
 @SetPlane2:
 Mov ax,0202h
 Jmp @SetThePlane
 @SetPlane3:
 Mov ax,0402h
 Jmp @SetThePlane
 @SetPlane4:
 Mov ax,0802h
 @SetThePlane:
 Mov bp,ax
 Out dx,ax
 Sub di,80*8
 Cmp bp,0102h
 Jne @NoAdd
 Add di,1
 @NoAdd:
 Dec bx
 Jnz @DrawHoriz

 @TheEnd:
 Pop bp
 Pop ds
END;

FUNCTION TwkGetPixel(x,y: Word): Byte; Assembler;
ASM
 {VGA address in es:}
 Mov ax,$A000
 Mov es,ax

 {Find position in video mem:}
 Mov ax,y
 Mov cx,80
 Mul cx
 Mov di,ax
 Mov bx,x
 Shr bx,2
 Add di,bx

 {Find plane:}
 Mov bx,x
 And bx,3
 Mov al,4
 Mov ah,bl

 Mov dx,3CEh
 Out dx,ax
 Mov al,es:[di]
END;

PROCEDURE TwkGet16x16(x,y:         Word;
                      imseg,imofs: Word); Assembler;
ASM
 Push ds
 Push bp

 {VGA address in es:}
 Mov ax,$A000
 Mov es,ax

 {Find position in video mem:}
 Mov ax,y
 Mov cx,80
 Mul cx
 Mov di,ax
 Mov bx,x
 Mov cl,bl
 Shr bx,2
 Add di,bx

 {Find plane:}
 Mov bx,x
 And bx,3
 Mov al,4
 Mov ah,bl

 Mov si,imofs
 Mov ds,imseg
 Mov bp,ax

 {Set initial plane:}
 Mov dx,3CEh
 Out dx,ax

 Cld
 Mov bx,6
 @DrawHoriz:
 Mov cx,8
 @DrawVertical:
 Mov al,es:[di]
 Mov ds:[si],al
 Inc si
 Add di,80
 Dec cx
 Jnz @DrawVertical

 @NextPlane:
 Cmp bp,0004h
 Je  @SetPlane2
 Cmp bp,0104h
 Je  @SetPlane3
 Cmp bp,0204h
 Je  @SetPlane4
 Mov ax,0004h
 Jmp @SetThePlane
 @SetPlane2:
 Mov ax,0104h
 Jmp @SetThePlane
 @SetPlane3:
 Mov ax,0204h
 Jmp @SetThePlane
 @SetPlane4:
 Mov ax,0304h
 @SetThePlane:
 Mov bp,ax
 Out dx,ax
 Sub di,80*8
 Cmp bp,0004h
 Jne @NoAdd
 Add di,1
 @NoAdd:
 Dec bx
 Jnz @DrawHoriz

 @TheEnd:
 Pop bp
 Pop ds
END;

END.